home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / x11 / tkbrain-.0 / tkbrain- / tkbrain / tkBrain < prev    next >
Text File  |  1996-01-14  |  9KB  |  329 lines
  1. #!/usr/local/bin/wish
  2. # tkBrain.tcl -- a game in tcl/tk
  3. # Author          : JΘr⌠me Santini  <js@zoe4>
  4. # Created On      : Fri Jan 12 18:11:52 1996
  5. # Last Modified By: JΘr⌠me Santini  <js@zoe4>
  6. # Last Modified On: Sun Jan 14 18:05:15 1996
  7. # File Path       : /home/js/tmp/tkbrain/tkBrain
  8. # Update Count    : 442
  9.  
  10. # initial height
  11. set taille_x 4    
  12. # initial width
  13. set taille_y 5    
  14.  
  15. # --------------------------------------------------------------------
  16. proc randomize { liste } {
  17.     set cmd [open [concat |randomize $liste] r]
  18.     set liste [gets $cmd]
  19.     close $cmd
  20.     return $liste
  21. }
  22.  
  23. # --------------------------------------------------------------------
  24. proc add_one { varname i j v} {
  25.     global taille_y
  26.     set num [expr $i * $taille_y + $j]
  27.     global $varname$num
  28.     
  29.     eval [format "set k $%s" $varname$num]
  30.     if { [string compare $k " "] != 0 } {
  31.     if { $v == 1} {
  32.         set $varname$num [expr $k == 4 ? 1 : $k + 1]
  33.     } else {
  34.         set $varname$num [expr $k == 1 ? 4 : $k - 1]
  35.     }
  36.     }
  37. }
  38.  
  39. # --------------------------------------------------------------------
  40. proc do_click { varname num v } {
  41.  
  42.     global $varname$num taille_y taille_x
  43.     set $varname$num $v
  44.  
  45.     set i [ expr $num / $taille_y ]
  46.     set j [ expr $num % $taille_y ]
  47.  
  48.     # puts "--> $num -> $i, $j"
  49.  
  50.     if { [string compare $v " "] != 0 } {
  51.     .d.$varname.l$i.c$j configure -state disabled -relief sunken 
  52.     } else {
  53.     .d.$varname.l$i.c$j configure -state normal -relief raised
  54.     set v -1
  55.     }
  56.  
  57.     if { $i > 0 } {
  58.     add_one $varname [expr $i - 1 ] $j $v
  59.     }
  60.     if { $i < [expr $taille_x - 1] } {
  61.     add_one $varname [expr $i + 1 ] $j $v
  62.     }
  63.     if { $j > 0 } {
  64.     add_one $varname $i [expr $j - 1 ] $v
  65.     }
  66.     if { $j < [expr $taille_y - 1 ] } {
  67.     add_one $varname $i [expr $j + 1 ] $v
  68.     }
  69. }
  70.  
  71. # --------------------------------------------------------------------
  72. # button's command
  73. proc click { num } {
  74.     global undo_list
  75.  
  76.     set undo_list [concat $num $undo_list]
  77.  
  78.     do_click aire $num 1
  79.  
  80.     redo_infos
  81. }
  82.  
  83. # --------------------------------------------------------------------
  84. proc undo { } {
  85.     global taille_x taille_y undo_cnt  undo_list
  86.  
  87.     if { [llength $undo_list] < 1 } {
  88.     .infos.text configure -text "Nothing to undo"    
  89.     return;
  90.     }
  91.     incr undo_cnt
  92.  
  93.     set num [lindex $undo_list 0]
  94.     set undo_list [lreplace $undo_list 0 0]
  95.  
  96.     do_click aire $num " "
  97.     redo_infos
  98. }
  99.  
  100. # --------------------------------------------------------------------
  101. proc retry { } {
  102.     global taille_x taille_y retry_cnt undo_list
  103.  
  104.     incr retry_cnt
  105.  
  106.     for {set i 0} { $i < $taille_x } {incr i} {
  107.     for {set j 0} { $j < $taille_y } {incr j} {
  108.         set num [expr $i * $taille_y + $j ]       
  109.         global aire$num
  110.         set aire$num " "
  111.         .d.aire.l$i.c$j configure -state normal -relief raised
  112.     }
  113.     }
  114.     set undo_list {}
  115.  
  116.     redo_infos
  117. }
  118.  
  119. # --------------------------------------------------------------------
  120. proc redo_infos { } {
  121.     global retry_cnt undo_cnt taille_x taille_y undo_list
  122.     set text ""
  123.     set cnt  [expr $taille_x * $taille_y]
  124.  
  125.     if { $retry_cnt > 0} {
  126.     set text "$retry_cnt retry"
  127.     }
  128.     
  129.     if { $undo_cnt > 0 } {
  130.     if { $retry_cnt > 0} {
  131.         set text [format "%s, " $text ]        
  132.     }
  133.     set text [format "%s%d undo" $text $undo_cnt ]        
  134.     }
  135.  
  136.     if { [llength $undo_list] == $cnt} {
  137.     set perdu 0
  138.     for {set i 0} { $i < $cnt } { incr i } {
  139.         global aire$i modele$i
  140.         eval [format "set k $%s" aire$i]
  141.         eval [format "set l $%s" modele$i]
  142.         if {$k != $l} {
  143.         set perdu 1
  144.         }
  145.     }
  146.     set text [format "%s %s" $text \
  147.         [expr {($perdu == 1) ? "You lost" : "You won" } ] ]
  148.     }
  149.     # if { [string length $text]} {
  150.     .infos.text configure -text $text
  151.     # }
  152. }
  153.  
  154. # --------------------------------------------------------------------
  155. proc new_game { } {
  156.     initialise
  157. }
  158.  
  159. # --------------------------------------------------------------------
  160. proc show_text { justify text } {
  161.     global widg_cnt
  162.     incr widg_cnt
  163.     set tl .about$widg_cnt
  164.     toplevel $tl -class Dialog
  165.     wm title $tl [wm title .]
  166.  
  167.     frame $tl.top -relief raised -bd 1
  168.     pack $tl.top -side top -fill both -expand true
  169.     frame $tl.bot -relief raised -bd 1
  170.     pack $tl.bot -side top -fill both -anchor s
  171.  
  172.     message $tl.top.msg -text $text -aspect 500 -justify $justify
  173.     button $tl.bot.b -text Ok -command "destroy $tl"
  174.  
  175.     pack $tl.top.msg -fill both -expand true
  176.     pack $tl.bot.b
  177.     
  178. }
  179.  
  180. # --------------------------------------------------------------------
  181. proc about { } {
  182.     show_text center \
  183.     "tkBrain v1.0 by JΘr⌠me Santini\n(santini@soleil.univ-orleans.fr)\n\n(14.01.1996)"
  184. }
  185.  
  186. proc help { } {
  187.     show_text left \
  188.     "The goal of this game is to reproduce the left grid on the right one. \
  189. When you click on a square, it is set to one, and one is added to all the \
  190. neighbours with a non-null value. If a square has a value of 4, \
  191. then it is reset to 1"
  192. }
  193.  
  194. # --------------------------------------------------------------------
  195. proc resize {  } {
  196.     global widg_cnt taille_x taille_y
  197.  
  198.     incr widg_cnt
  199.     set tl .about$widg_cnt
  200.     toplevel $tl -class Dialog
  201.     wm title $tl [wm title .]
  202.  
  203.     frame $tl.top -relief raised -bd 1
  204.  
  205.     scale $tl.width -label Width -from 2 -to 10 -length 8c \
  206.         -orient horizontal 
  207.     $tl.width set $taille_y
  208.     
  209.     scale $tl.height -label Height -from 2 -to 10 -length 8c \
  210.         -orient horizontal
  211.     $tl.height set $taille_x
  212.  
  213.     pack $tl.width $tl.height -in $tl.top -expand 1 -fill x
  214.  
  215.     frame $tl.bot -relief raised -bd 1
  216.  
  217.     button $tl.bot.ok -text Ok -command "do_resize $tl"
  218.     button $tl.bot.cancel -text Cancel -command "destroy $tl"
  219.  
  220.     pack $tl.bot.ok $tl.bot.cancel -side left  -expand 1
  221.  
  222.     pack $tl.top -side top -fill both -expand 1
  223.     pack $tl.bot -side top -fill both -anchor s
  224. }
  225.  
  226. # --------------------------------------------------------------------
  227. proc do_resize { widg } {
  228.     global taille_x taille_y
  229.  
  230.     set taille_x [$widg.height get]; 
  231.     set taille_y [$widg.width get]; 
  232.  
  233.     destroy $widg ;
  234.     initialise
  235. }
  236.  
  237. # --------------------------------------------------------------------
  238. # initialisation de l'aire de jeux
  239. proc initialise {} {
  240.     global undo_list taille_x taille_y retry_cnt undo_cnt
  241.     set undo_list {}
  242.     set liste {}
  243.     set retry_cnt 0
  244.     set undo_cnt 0
  245.  
  246.     .infos.text configure -text "tkBrain by JΘr⌠me Santini"
  247.     destroy .d
  248.     frame .d
  249.     frame .d.modele -relief raised -bord 0
  250.     frame .d.sep -width 0.8c
  251.     frame .d.aire -relief raised -bord 0
  252.     for {set i 0} { $i < $taille_x } {incr i} {
  253.     frame .d.modele.l$i 
  254.     frame .d.aire.l$i 
  255.     for {set j 0} { $j < $taille_y } {incr j} {
  256.         set num [expr $i * $taille_y + $j ]
  257.         set liste [concat $liste $num]
  258.         global modele$num  aire$num
  259.         set modele$num " "
  260.         set aire$num " "
  261.  
  262.         # puts [concat $num $i $j ]
  263.  
  264.         button .d.modele.l$i.c$j -textvar modele$num \
  265.             -bd 1 -disabledfore black
  266.         button .d.aire.l$i.c$j  -textvar aire$num -bd 1\
  267.              -disabledfore black \
  268.             -command "click $num"
  269.         pack .d.modele.l$i.c$j .d.aire.l$i.c$j -side left -fill both \
  270.             -expand true
  271.     }
  272.     pack .d.modele.l$i .d.aire.l$i -side top -fill both -expand true 
  273.     }
  274.     set liste [randomize $liste]
  275.     foreach i $liste {
  276.     do_click  modele $i 1
  277.     }
  278.     pack .d.modele .d.sep .d.aire -side left -fill both -expand true \
  279.         -padx 0
  280.     pack .d -fill both -expand true -anchor center
  281. }
  282.  
  283. # --------------------------------------------------------------------
  284. # main
  285. #
  286.  
  287. set widg_cnt 0
  288.  
  289. # menu
  290. frame .infos
  291. frame .mbar -bd 2 -relief raised 
  292. menubutton .mbar.menu -text tkBrain -underline 0 -menu .mbar.menu.menu
  293. menubutton .mbar.help -text Help -underline 0 -menu .mbar.help.help
  294.  
  295. menu .mbar.menu.menu
  296. .mbar.menu.menu add command -label "Undo" -underline 0 -command undo
  297. .mbar.menu.menu add command -label "Retry" -underline 0 -command retry
  298. .mbar.menu.menu add command -label "New Game" -underline 0 -command new_game
  299. .mbar.menu.menu add command -label "Resize..." -underline 2 -command resize
  300. .mbar.menu.menu add separator
  301. .mbar.menu.menu add command -label "Quit" -underline 0 -command "destroy ."
  302.  
  303. menu .mbar.help.help -tearoff 0
  304. .mbar.help.help add command -label "About..." -command about
  305. .mbar.help.help add command -label "Help..." -command help
  306.  
  307. pack .mbar.menu -side left
  308. pack .mbar.help -side right 
  309.  
  310. tk_menuBar .mbar .mbar.menu .mbar.help
  311. focus .mbar
  312. # text area
  313. label .infos.text -relief sunken -border 1
  314.  
  315.  
  316. pack .mbar -fill x -in .infos
  317. pack .infos.text -fill x 
  318. pack .infos  -fill x  -anchor n
  319.  
  320.  
  321. # to be destroy by initialise
  322. frame .d
  323. initialise
  324.  
  325. # eof ---------------------------------------------------------------
  326. # Local Variables:
  327. # mode: tcl
  328. # End:
  329.